home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / laplace.src < prev    next >
Text File  |  1994-01-04  |  5KB  |  139 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ LAPLACE by John Meissner
  3. DIR
  4.   L2EQ
  5.     \<< DUP ROT ROT PF SWAP \->QUAD 0 0 0 0 0 1
  6.       \-> numer denom count a b r1 r2 dups
  7.       \<< denom SIZE 1
  8.         FOR count
  9.           IF count denom SIZE <
  10.           THEN
  11.             IF denom count GETI ROT ROT GET ==
  12.             THEN dups 1 + 'dups' STO
  13.             ELSE 1 'dups' STO
  14.             END
  15.           END denom count GET
  16.           IF DUP TYPE 5 ==
  17.           THEN LIST\-> DROP
  18.             IF OVER
  19.             THEN 2 \->LIST { 1 0 0 } PADD RT DROP C\->R 'r2' STO
  20.               NEG 'r1' STO numer count GET 1 r1 2 \->LIST PDIV
  21.               LIST\-> DROP 'b' STO LIST\-> DROP 'a' STO
  22.               'a*EXP(-r1*T)*COS(r2*T)*u(T)+b/r2*EXP(-r1*T)*SIN(r2*T)*u(T)'
  23.               EVAL
  24.             ELSE \v/ 'r2' STO 'r1' STO numer count GET LIST\-> DROP
  25.             'b' STO 'a' STO
  26.               IF dups 1 >
  27.               THEN
  28.                 'a*T*COS(r2*T)*u(T)+b/(2*r2)*T*SIN(r2*T)*u(T)' EVAL
  29.               ELSE
  30.                 'a*COS(r2*T)*u(T)+b/r2*SIN(r2*T)*u(T)' EVAL
  31.               END
  32.             END
  33.           ELSE 'r1' STO numer count GET 'a' STO
  34.             IF r1
  35.             THEN
  36.               IF dups 1 >
  37.               THEN
  38.                 'a/(dups-1)!*T^(dups-1)*EXP(-r1*T)*u(T)' EVAL
  39.               ELSE
  40.                 'a*EXP(-r1*T)*u(T)' EVAL
  41.               END
  42.             ELSE
  43.               IF dups 1 >
  44.               THEN
  45.                 'a/(dups-1)!*T^(dups-1)*u(T)' EVAL
  46.               ELSE
  47.                 'a*u(T)' EVAL
  48.               END
  49.             END
  50.           END
  51.           IF count denom SIZE <
  52.           THEN +
  53.           END -1
  54.         STEP
  55.       \>>
  56.     \>>
  57.   \->QUAD
  58.     \<< DUP SIZE 0 0 0 0
  59.       \<<
  60.         IF DUP IM NOT
  61.         THEN RE
  62.         END
  63.       \>> \-> numer denom count a b r1 r2 reduce
  64.       \<<
  65.         WHILE count 1 >
  66.         REPEAT denom count 1 - GETI 'r1' STO GET 'r2' STO
  67.           IF r1 IM 0 \=/ r1 CONJ r2 == AND
  68.           THEN numer count 1 - GETI 'a' STO GET 'b' STO
  69.             denom count 1 - r1 r2 + NEG reduce EVAL r1 r2 * reduce EVAL
  70.             2 \->LIST PUT LIST\-> DUP count - 2 + ROLL DROP 1 - \->LIST
  71.             'denom' STO numer count 1 - a b + reduce EVAL a r2 * b r1 *
  72.             + NEG reduce EVAL 2 \->LIST PUT LIST\-> DUP count - 2 + ROLL
  73.             DROP 1 - \->LIST 'numer' STO count 2 - 'count' STO
  74.           ELSE denom count DUP2 GET NEG PUT 'denom' STO numer count DUP2
  75.             GET reduce EVAL PUT 'numer' STO count 1 - 'count' STO
  76.           END
  77.         END numer denom
  78.         IF count
  79.         THEN SWAP 1 DUP2 GET reduce EVAL PUT SWAP 1 DUP2 GET NEG PUT
  80.         END
  81.       \>>
  82.     \>>
  83.   \->L
  84.     \<<
  85.       { '&k*(T-&a)^&n*u(T-&a)' '&k*&n!/S^(&n+1)*EXP(-&a*S)' } \|vMATCH DROP
  86.       { '&k*u(T-&a)' '&k*u(T)*EXP(-&a*S)' } \|vMATCH DROP
  87.       { '&k*r(T-&a)' '&k*r(T)*EXP(-&a*S)' } \|vMATCH DROP
  88.       { '&k*d(T-&a)' '&k*d(T)*EXP(-&a*S)' } \|vMATCH DROP
  89.       { '&k*d(T)' &k } \|vMATCH DROP
  90.       { '&k*r(T)' '&k/S^2' } \|vMATCH DROP
  91.       { '&k*T^&n*u(T)' '&k*&n!/S^(&n+1)' } \|vMATCH DROP
  92.       { '&k*T^&n*EXP(&a*T)*u(T)' '&k*&n!/(S-&a)^(&n+1)' } \|vMATCH DROP
  93.       { '&k*EXP(&a*T)*COS(&\Gw*T)*u(T)' '&k*(S-&a)/((S-&a)^2+&\Gw^2)' }
  94.         \|vMATCH DROP
  95.       { '&k*EXP(&a*T)*SIN(&\Gw*T)*u(T)' '&k*&\Gw/((S-&a)^2+&\Gw^2)' }
  96.         \|vMATCH DROP
  97.       { '&k*T*COS(&\Gw*T)*u(T)' '&k*(S^2-&\Gw^2)/(S^2+&\Gw^2)^2' }
  98.         \|vMATCH DROP
  99.       { '&k*T*SIN(&\Gw*T)*u(T)' '&k/(2*&\Gw)*S/(S^2+&\Gw)^2' } \|vMATCH DROP
  100.       { '&k*COS(&\Gw*T+&\Gh)*u(T)'
  101.         '&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
  102.       { '&k*SIN(&\Gw*T+&\Gh)*u(T)'
  103.         '&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
  104.       { '&k*COS(&\Gw*T)*u(T)' '&k*S/(S^2+&\Gw^2)' } \|vMATCH DROP
  105.       { '&k*SIN(&\Gw*T)*u(T)' '&k*&\Gw/(S^2+&\Gw^2)' } \|vMATCH DROP
  106.       { '&k*(EXP(&\Ga*T)-EXP(&\Gg*T))*u(T)' '&k/((S-&\Ga)*(S-&\Gg))' }
  107.         \|vMATCH DROP
  108.       { '&k*EXP(&a*T)*u(T)' '&k/(S-&a)'} \|vMATCH DROP
  109.       { '&k*u(T)' '&k/S' } \|vMATCH DROP
  110.     \>>
  111.   L\->
  112.     \<<
  113.       { '&k/S' '&k*u(T)' } \|vMATCH DROP
  114.       { '&k/(S+&a)' '&k*EXP(-&a*T)*u(T)' } \|vMATCH DROP
  115.       { '&k/S^2' '&k*r(T)' } \|vMATCH DROP
  116.       { '&k/S^&n' '&k/(&n-1)!*T^(&n-1)*u(T)' } \|vMATCH DROP
  117.       { '&k/(S+&a)^&n' '&k/(&n-1)!*T^(&n-1)*EXP(-&a*T)*u(T)' } \|vMATCH DROP
  118.       { '&k/S^&n*EXP(&a*S)' '&k/(&n-1)!*(T-&a)^(&n-1)*u(T-&a)' } \|vMATCH DROP
  119.       { '&k*(S+&a)/((S+&a)^2+&\Gw)' '&k*EXP(-&a*T)*COS(\v/&\Gw*T)*u(T)' }
  120.         \|vMATCH DROP
  121.       { '&k/((S+&a)^2+&\Gw)' '&k/\v/&\Gw*EXP(-&a*T)*SIN(\v/&\Gw*T)*u(T)' }
  122.         \|vMATCH DROP
  123.       { '&k*(S^2-&\Gw)/(S^2+&\Gw)^2' '&k*T*COS(\v/&\Gw*T)*u(T)' }
  124.         \|vMATCH DROP
  125.       { '&k*S/(S^2+&\Gw)^2' '&k/(2*\v/&\Gw)*T*SIN(\v/&\Gw*T)*u(T)' }
  126.         \|vMATCH DROP
  127.       { '&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gr)'
  128.         '&k*COS(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
  129.       { '&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gr)'
  130.         '&k*SIN(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
  131.       { '&k*S/(S^2+&\Gw)' '&k*COS(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
  132.       { '&k/(S^2+&\Gw)' '&k/\v/&\Gw*SIN(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
  133.       { '&k/((S+&\Ga)*(S+&\Gg))'
  134.         '&k/(&\Gg-&\Ga)*(EXP(-&\Ga*T)-EXP(-&\Gg*T))*u(T)' } \|vMATCH DROP
  135.       { '&k*&f(T)*EXP(&a*S)' '&k*&f(T+&a)' } \|vMATCH DROP
  136.       { '&k*EXP(&a*S)' '&k*d(T+&a)' } \|vMATCH DROP
  137.     \>>
  138. END
  139.